packages = c('readxl', 'datawizard', 'crosstalk', 'tidyr', 'lubridate','tidyverse', 'plotly', 'd3scatter','tidyquant')
for(p in packages){
if(!require(p,character.only = T)){
install.packages(p)
}
library(p,character.only = T)
}1 The task
In this take-home exercise, you are required to uncover the impact of COVID-19 as well as the global economic and political dynamic in 2022 on Singapore bi-lateral trade (i.e. Import, Export and Trade Balance) by using appropriate analytical visualisation techniques learned in Lesson 6: It’s About Time. Students are encouraged to apply appropriate interactive techniques to enhance user and data discovery experiences.
The write-up of the take-home exercise should include but not limited to the followings:
- Describe the selection and designed consideration of the analytical data visualisation used. The discussion should limit to not more than 150 words each.
- A reproducible description of the procedures used to prepare the analytical visualisation. Please refer to the peer submission I shared.
- A write-up of not more than 100 words to discuss the patterns reveal by each analytical visualization prepared.
Packages
2 Data
Merchandise Trade provided by Department of Statistics, Singapore (DOS) is used. The study period is between January 2020 to December 2022.
Checking the number of sheets it contains
excel_sheets("data/data.xlsx")[1] "Content" "T1" "T2" Importing data
In the code chunk below, read_xlsx() of readxl package is used to import the data worksheet of our data workbook into R.
T1 <- read_xlsx("data/data.xlsx", sheet = "T1")
T2 <- read_xlsx("data/data.xlsx", sheet = "T2")Formatting data
# Transpose the fat table to long table
T1 <- gather(T1, "MonthYear", "ImportValue", -`Data Series`)
T2 <- gather(T2, "MonthYear", "ExportValue", -`Data Series`)
Note
ymd_hms() and hour() are from lubridate package
# Convert MonthYear column to date format
T1$`MonthYear` <- ym(T1$`MonthYear`)
T2$`MonthYear` <- ym(T2$`MonthYear`)
# Convert ImportValue column to numeric format
T1$`ImportValue` <- as.numeric(T1$`ImportValue`)
T2$`ExportValue` <- as.numeric(T2$`ExportValue`)Separate region and country
Code
# =================== Import =================== #
Region <- T1 %>%
filter(grepl('Million', `Data Series`)) %>%
rename("Region" = "ImportValue")
Country <- T1 %>%
filter(grepl('Thousand', `Data Series`)) %>%
rename("Country" = "ImportValue")
Import <- full_join(Region, Country, by = join_by(`Data Series`, `MonthYear`))
Import <- gather(Import , "Level", "ImportValue", -`Data Series`, -`MonthYear`)
# =================== Export =================== #
Region <- T2 %>%
filter(grepl('Million', `Data Series`)) %>%
rename("Region" = "ExportValue")
Country <- T2 %>%
filter(grepl('Thousand', `Data Series`)) %>%
rename("Country" = "ExportValue")
Export <- full_join(Region, Country, by = join_by(`Data Series`, `MonthYear`))
Export <- gather(Export , "Level", "ExportValue", -`Data Series`, -`MonthYear`)Filter date and rename column
Import <- Import %>%
filter(`MonthYear`>= as.Date("2009-12-01")) %>%
rename(`Country` = `Data Series`)
Export <- Export %>%
filter(`MonthYear`>= as.Date("2009-12-01")) %>%
rename(`Country` = `Data Series`)Merge Import and Export into one table
data1 <- full_join(Import, Export, by = join_by(`Country`, `MonthYear`,`Level`))
data1 <- data1 %>%
mutate("Diff" = ImportValue-ExportValue)
data1$`Country` <- str_replace(data1$`Country`, "Mainland China", "China")
data <- gather(data1 , "Type", "Value", -`Country`, -`MonthYear`,-`Level`)2.1 Table: Merchandise Imports/Export By Region/Market, Monthly
| Country | MonthYear | Level | ImportValue |
|---|---|---|---|
| America (Million Dollars) | 2022-12-01 | Region | 6901.5 |
| Asia (Million Dollars) | 2022-12-01 | Region | 33611.7 |
| Europe (Million Dollars) | 2022-12-01 | Region | 7541.8 |
| Oceania (Million Dollars) | 2022-12-01 | Region | 1399.9 |
| Africa (Million Dollars) | 2022-12-01 | Region | 414.9 |
| European Union (Million Dollars) | 2022-12-01 | Region | 5058.8 |
| America (Million Dollars) | 2022-11-01 | Region | 7529.4 |
| Asia (Million Dollars) | 2022-11-01 | Region | 34733.7 |
| Europe (Million Dollars) | 2022-11-01 | Region | 7242.8 |
| Oceania (Million Dollars) | 2022-11-01 | Region | 664.4 |
| Country | MonthYear | Level | ExportValue |
|---|---|---|---|
| America (Million Dollars) | 2022-12-01 | Region | 6217.5 |
| Asia (Million Dollars) | 2022-12-01 | Region | 39734.8 |
| Europe (Million Dollars) | 2022-12-01 | Region | 4924.4 |
| Oceania (Million Dollars) | 2022-12-01 | Region | 3034.8 |
| Africa (Million Dollars) | 2022-12-01 | Region | 1088.6 |
| European Union (Million Dollars) | 2022-12-01 | Region | 4137.1 |
| America (Million Dollars) | 2022-11-01 | Region | 6394.2 |
| Asia (Million Dollars) | 2022-11-01 | Region | 37973.2 |
| Europe (Million Dollars) | 2022-11-01 | Region | 5025.2 |
| Oceania (Million Dollars) | 2022-11-01 | Region | 3243.1 |
2.2 Scatter plot Dashboard
Code
hline <- function(y = 0, color = "steelblue") {
list(
type = "line",
x0 = 0, x1 = 1,
xref = "paper",
y0 = y, y1 = y,
line = list(color = color, dash="dot")
)
}
vline <- function(x = 0, color = "steelblue") {
list(
type = "line",
y0 = 0, y1 = 1,
yref = "paper",
x0 = x, x1 = x,
line = list(color = color, dash="dot")
)
}
fig <- data1 %>%
plot_ly(
x = ~`ImportValue`,
y = ~`ExportValue`,
color = ~`Country`,
# colors = "PuOr",
frame = ~year(`MonthYear`),
text= ~paste("Country:",`Country`,
"\nImport Value:", `ImportValue`,
"\nExport Value:", `ExportValue`,
"\nMonth Year:", `MonthYear`),
hoverinfo = "text",
type = 'scatter',
mode = 'markers'
)
annotations = list(
list(
x = 0.25,
y = 0.85,
font = list(size = 10, color = "grey"),
text = "Low Import - High Export",
xref = "paper",
yref = "paper",
xanchor = "center",
yanchor = "center",
showarrow = FALSE
),
list(
x = 0.8,
y = 0.85,
font = list(size = 12, color = "grey"),
text = "High Import - High Export",
xref = "paper",
yref = "paper",
xanchor = "center",
yanchor = "center",
showarrow = FALSE
),
list(
x = 0.25,
y = 0.35,
font = list(size = 12, color = "grey"),
text = "Low Import - Low Export",
xref = "paper",
yref = "paper",
xanchor = "center",
yanchor = "center",
showarrow = FALSE
),
list(
x = 0.8,
y = 0.35,
font = list(size = 12, color = "grey"),
text = "High Import - Low Export",
xref = "paper",
yref = "paper",
xanchor = "center",
yanchor = "center",
showarrow = FALSE
)
)
fig <- fig %>%
layout(title = list(text="Import - Export"),
hoverlabel = list(align = "left"),
shapes = list(hline(5000000), vline(5000000)),
annotations = annotations,
legend = list(orientation = "h", y = 1, x = 0),
showlegend = FALSE,
xaxis = list(title="Import Value", range = list(0, 10000000)),
yaxis = list(title="Export Value", range = list(0, 10000000))
)
fig <- fig %>%
animation_opts(
2000, easing = "linear", redraw = FALSE
)
fig
Insights
- Mainland China is range with a High Import - High Export spectrum. From 2020 to 2021, there was a significant increase in value, particularly export value.
- Taiwan import rate has continuously grown but we can observed significant jump of import value in 2021 after COVID.
2.3 Interactive Dashboard
Code
# Building interactive filters
d <- highlight_key(data)
filter_tools <- htmltools::div(
filter_select(id = "country",
label = "Select Country",
sharedData = d,
group = ~Country,
multiple=FALSE),
filter_slider(id = "period",
label = "Select period",
sharedData = d,
column = ~year(MonthYear),
width = "100%"),
filter_slider(id = "value",
label = "Select Value",
sharedData = d,
column = ~Value,
width = "100%"),
filter_checkbox(id = "variable",
label = "Select variable",
sharedData = d,
group = ~Type,
inline = FALSE))
vline <- function(x = 0, color = "steelblue") {
list(
type = "line",
y0 = 0, y1 = 1,
yref = "paper",
x0 = x, x1 = x,
line = list(color = color, dash="dot")
)
}
# plotting interactive scatter plot using plotly
p <- plot_ly(data=d,
type= "scatter",
mode= "line",
x= ~MonthYear,
y= ~Value,
color= ~Type,
colors= "Accent",
text= ~paste("Country:",`Country`,
"\nMonth Year:", `MonthYear`,
"\nType:",`Type`)) %>%
layout(title = list(text="<b>Import/Export trend</b>"),
hoverlabel = list(align = "left"),
legend = list(orientation = "h", y = 1, x = 0),
shapes = vline("2019"),
xaxis = list(title="Value"),
yaxis = list(title="Month Year"))
gg <- highlight(p, "plotly_selected")
# Using crosstalk bscols to put all 3 elements (filter, scatter plot, datatable) together.
crosstalk::bscols(filter_tools,gg,DT::datatable(d, class= "display",
filter=list(position="top", clear=FALSE),
options=list(pageLength = 10,scrollY = TRUE,
iDisplayLength = 25)),
widths = c(4, 8, 12),
annotations = list(caption = "Data from Department of Statistics, Singapore (DOS)"))